library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(dplyr)
library(car)
## Loading required package: carData
##
## Attaching package: 'car'
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following object is masked from 'package:purrr':
##
## some
library(ggplot2)
library(lubridate)
library(scales)
##
## Attaching package: 'scales'
##
## The following object is masked from 'package:purrr':
##
## discard
##
## The following object is masked from 'package:readr':
##
## col_factor
library(ARTool)
data <- read_csv("study_tasks.csv")
## Rows: 49244 Columns: 35
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (9): TaskID, ActionID, distance, direction, complexity, zoomDirection,...
## dbl (22): UserID, main_translation_x, main_translation_y, main_translation_...
## lgl (3): rotateGlobeWhileDragging, oneHandedRotationGesture, moveGlobeWhil...
## dttm (1): Date
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
demographic <- read_csv("final_introductory.csv")
## Rows: 12 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): Timestamp, Academic_level, Gender, Age_group, Exp_ARVR, Globe_usage...
## dbl (1): UserID
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
positioning_NRG <- read_csv("final_positioning_NRG.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Mentally_demanding, Physically_demanding
## dbl (1): UserID
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
positioning_RG <- read_csv("final_positioning_RG.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Mentally_demanding, Physically_demanding
## dbl (1): UserID
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
positioning_preference <- read_csv("final_positioning_comparison.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Positioning_preference, Positioning_feedback
## dbl (1): UserID
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
rotation_OH <- read_csv("final_rotation_OH.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Mentally_demanding, Physically_demanding
## dbl (1): UserID
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
rotation_TH <- read_csv("final_rotation_TH.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Mentally_demanding, Physically_demanding
## dbl (1): UserID
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
rotation_preference <- read_csv("final_rotation_comparison.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Rotation_preference, Rotation_feedback
## dbl (1): UserID
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
scale_MG <- read_csv("final_scale_MG.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Mentally_demanding, Physically_demanding
## dbl (1): UserID
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
scale_NMG <- read_csv("final_scale_NMG.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Mentally_demanding, Physically_demanding
## dbl (1): UserID
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
scale_preference <- read_csv("final_scale_comparison.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Scale_preference, Scale_feedback
## dbl (1): UserID
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
combined_preference <- read_csv("final_outro_comparison.csv")
## Rows: 12 Columns: 6
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (5): Timestamp, Combined_positioning_preference, Combined_rotation_prefe...
## dbl (1): UserID
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
summary(data)
## UserID TaskID ActionID
## Min. : 1.000 Length:49244 Length:49244
## 1st Qu.: 4.000 Class :character Class :character
## Median : 7.000 Mode :character Mode :character
## Mean : 6.741
## 3rd Qu.:10.000
## Max. :12.000
## rotateGlobeWhileDragging oneHandedRotationGesture moveGlobeWhileScaling
## Mode :logical Mode :logical Mode :logical
## FALSE:36803 FALSE:11933 FALSE:46552
## TRUE :12441 TRUE :37311 TRUE :2692
##
##
##
## distance direction complexity zoomDirection
## Length:49244 Length:49244 Length:49244 Length:49244
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## Date Type ActionStatus
## Min. :2025-04-23 05:27:13.00 Length:49244 Length:49244
## 1st Qu.:2025-04-25 01:36:58.00 Class :character Class :character
## Median :2025-04-26 00:45:01.00 Mode :character Mode :character
## Mean :2025-04-27 21:46:53.98
## 3rd Qu.:2025-05-01 07:26:51.00
## Max. :2025-05-05 23:37:33.00
## main_translation_x main_translation_y main_translation_z main_rotation_x
## Min. :-7.099065 Min. :-0.3298 Min. :-3.487 Min. :-0.97540
## 1st Qu.:-0.400000 1st Qu.: 0.9000 1st Qu.:-1.921 1st Qu.:-0.03161
## Median :-0.004060 Median : 0.9000 Median :-1.500 Median : 0.00000
## Mean :-0.005048 Mean : 1.2326 Mean :-1.683 Mean :-0.03896
## 3rd Qu.: 0.400000 3rd Qu.: 1.5539 3rd Qu.:-1.500 3rd Qu.: 0.00000
## Max. : 3.256168 Max. : 3.8304 Max. : 5.006 Max. : 0.97834
## main_rotation_y main_rotation_z main_rotation_w main_scale_x
## Min. :-1.0000 Min. :-0.97710 Min. :-0.9997261 Min. :0.08431
## 1st Qu.:-0.2033 1st Qu.: 0.00000 1st Qu.: 0.0000001 1st Qu.:0.99989
## Median : 0.9601 Median : 0.00000 Median : 0.0626987 Median :1.00000
## Mean : 0.5003 Mean : 0.01287 Mean : 0.2756917 Mean :0.99575
## 3rd Qu.: 1.0000 3rd Qu.: 0.00000 3rd Qu.: 0.6346812 3rd Qu.:1.00002
## Max. : 1.0000 Max. : 0.98922 Max. : 0.9999814 Max. :7.69231
## main_scale_y main_scale_z target_translation_x target_translation_y
## Min. :0.08431 Min. :0.08431 Min. :-3.10000 Min. :0.613
## 1st Qu.:0.99994 1st Qu.:0.99990 1st Qu.:-0.40000 1st Qu.:0.900
## Median :1.00000 Median :1.00000 Median : 0.00000 Median :0.900
## Mean :0.99577 Mean :0.99576 Mean :-0.02449 Mean :1.245
## 3rd Qu.:1.00002 3rd Qu.:1.00002 3rd Qu.: 0.40000 3rd Qu.:1.773
## Max. :7.69231 Max. :7.69231 Max. : 2.33777 Max. :2.547
## target_translation_z target_rotation_x target_rotation_y target_rotation_z
## Min. :-3.3210 Min. :-0.3928 Min. :-0.6935 Min. :-0.21194
## 1st Qu.:-1.9598 1st Qu.:-0.3584 1st Qu.:-0.5655 1st Qu.: 0.00000
## Median :-1.5000 Median : 0.0000 Median : 1.0000 Median : 0.00000
## Mean :-1.6971 Mean :-0.1153 Mean : 0.3768 Mean :-0.01644
## 3rd Qu.:-1.5000 3rd Qu.: 0.0000 3rd Qu.: 1.0000 3rd Qu.: 0.00000
## Max. :-0.8953 Max. : 0.0000 Max. : 1.0000 Max. : 0.13795
## target_rotation_w target_scale_x target_scale_y target_scale_z
## Min. :-0.9761015 Min. :0.1700 Min. :0.1700 Min. :0.1700
## 1st Qu.: 0.0000001 1st Qu.:1.0000 1st Qu.:1.0000 1st Qu.:1.0000
## Median : 0.0000001 Median :1.0000 Median :1.0000 Median :1.0000
## Mean : 0.2914215 Mean :0.9946 Mean :0.9946 Mean :0.9946
## 3rd Qu.: 0.7119398 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.0000
## Max. : 0.9807853 Max. :2.0000 Max. :2.0000 Max. :2.0000
## match_accuracy_result status
## Min. : 0.00000 Length:49244
## 1st Qu.: 0.00000 Class :character
## Median : 0.00000 Mode :character
## Mean : 0.03784
## 3rd Qu.: 0.00000
## Max. :22.31002
summary(demographic)
## UserID Timestamp Academic_level Gender
## Min. : 1.00 Length:12 Length:12 Length:12
## 1st Qu.: 3.75 Class :character Class :character Class :character
## Median : 6.50 Mode :character Mode :character Mode :character
## Mean : 6.50
## 3rd Qu.: 9.25
## Max. :12.00
## Age_group Exp_ARVR Globe_usage_frequency
## Length:12 Length:12 Length:12
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## Have_used_VisionPro
## Length:12
## Class :character
## Mode :character
##
##
##
summary(positioning_NRG)
## UserID Timestamp Mentally_demanding Physically_demanding
## Min. : 1.00 Length:12 Length:12 Length:12
## 1st Qu.: 3.75 Class :character Class :character Class :character
## Median : 6.50 Mode :character Mode :character Mode :character
## Mean : 6.50
## 3rd Qu.: 9.25
## Max. :12.00
summary(positioning_RG)
## UserID Timestamp Mentally_demanding Physically_demanding
## Min. : 1.00 Length:12 Length:12 Length:12
## 1st Qu.: 3.75 Class :character Class :character Class :character
## Median : 6.50 Mode :character Mode :character Mode :character
## Mean : 6.50
## 3rd Qu.: 9.25
## Max. :12.00
summary(positioning_preference)
## UserID Timestamp Positioning_preference Positioning_feedback
## Min. : 1.00 Length:12 Length:12 Length:12
## 1st Qu.: 3.75 Class :character Class :character Class :character
## Median : 6.50 Mode :character Mode :character Mode :character
## Mean : 6.50
## 3rd Qu.: 9.25
## Max. :12.00
summary(rotation_OH)
## UserID Timestamp Mentally_demanding Physically_demanding
## Min. : 1.00 Length:12 Length:12 Length:12
## 1st Qu.: 3.75 Class :character Class :character Class :character
## Median : 6.50 Mode :character Mode :character Mode :character
## Mean : 6.50
## 3rd Qu.: 9.25
## Max. :12.00
summary(rotation_TH)
## UserID Timestamp Mentally_demanding Physically_demanding
## Min. : 1.00 Length:12 Length:12 Length:12
## 1st Qu.: 3.75 Class :character Class :character Class :character
## Median : 6.50 Mode :character Mode :character Mode :character
## Mean : 6.50
## 3rd Qu.: 9.25
## Max. :12.00
summary(rotation_preference)
## UserID Timestamp Rotation_preference Rotation_feedback
## Min. : 1.00 Length:12 Length:12 Length:12
## 1st Qu.: 3.75 Class :character Class :character Class :character
## Median : 6.50 Mode :character Mode :character Mode :character
## Mean : 6.50
## 3rd Qu.: 9.25
## Max. :12.00
summary(scale_MG)
## UserID Timestamp Mentally_demanding Physically_demanding
## Min. : 1.00 Length:12 Length:12 Length:12
## 1st Qu.: 3.75 Class :character Class :character Class :character
## Median : 6.50 Mode :character Mode :character Mode :character
## Mean : 6.50
## 3rd Qu.: 9.25
## Max. :12.00
summary(scale_NMG)
## UserID Timestamp Mentally_demanding Physically_demanding
## Min. : 1.00 Length:12 Length:12 Length:12
## 1st Qu.: 3.75 Class :character Class :character Class :character
## Median : 6.50 Mode :character Mode :character Mode :character
## Mean : 6.50
## 3rd Qu.: 9.25
## Max. :12.00
summary(scale_preference)
## UserID Timestamp Scale_preference Scale_feedback
## Min. : 1.00 Length:12 Length:12 Length:12
## 1st Qu.: 3.75 Class :character Class :character Class :character
## Median : 6.50 Mode :character Mode :character Mode :character
## Mean : 6.50
## 3rd Qu.: 9.25
## Max. :12.00
summary(combined_preference)
## UserID Timestamp Combined_positioning_preference
## Min. : 1.00 Length:12 Length:12
## 1st Qu.: 3.75 Class :character Class :character
## Median : 6.50 Mode :character Mode :character
## Mean : 6.50
## 3rd Qu.: 9.25
## Max. :12.00
## Combined_rotation_preference Combined_scale_preference Combined_feedback
## Length:12 Length:12 Length:12
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
# Total number of participants
length(unique(data$UserID))
## [1] 12
# Participants' gender distribution
demographic.gender <- demographic %>%
select(UserID, Gender) %>%
distinct() %>%
group_by(Gender) %>%
summarise(count = n()) %>%
mutate(percentage = round(count / sum(count) * 100, 1), percentage = paste0(percentage, "%"))
demographic.gender
## # A tibble: 2 × 3
## Gender count percentage
## <chr> <int> <chr>
## 1 Man 10 83.3%
## 2 Woman 2 16.7%
# Participants' gender distribution chart
ggplot(demographic.gender, aes(x = "", y = count, fill = Gender)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
geom_text(aes(label = percentage), position = position_stack(vjust = 0.5), size = 4) +
labs(title = "Distribution of Participants' Gender") +
theme_void()
# Participants' academic level distribution
demographic.academic_level <- demographic %>%
select(UserID, Academic_level) %>%
distinct() %>%
group_by(Academic_level) %>%
summarise(count = n()) %>%
mutate(percentage = round(count / sum(count) * 100, 1), graph_label = paste0(percentage, "%")) %>%
rename(`Academic levels` = Academic_level)
demographic.academic_level
## # A tibble: 3 × 4
## `Academic levels` count percentage graph_label
## <chr> <int> <dbl> <chr>
## 1 Graduate Student 10 83.3 83.3%
## 2 Postdoctoral Researcher 1 8.3 8.3%
## 3 Undergraduate Student 1 8.3 8.3%
# Participants' academic level distribution chart
ggplot(demographic.academic_level, aes(x = "", y = count, fill = `Academic levels`)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
geom_text(aes(label = graph_label), position = position_stack(vjust = 0.5), size = 4) +
labs(title = "Distribution of Participants' Academic Level") +
theme_void()
# Participants' previous AR/VR experience distribution
demographic.ARVR_exp <- demographic %>%
select(UserID, Exp_ARVR ) %>%
distinct() %>%
group_by(Exp_ARVR) %>%
summarise(count = n()) %>%
mutate(percentage = round(count / sum(count) * 100, 1),
label = paste0(percentage, "%"),
ShortLabel = fct_recode(Exp_ARVR,
"No experience" = "I have no experience")
) %>%
rename(`Previous AR/VR experience` = ShortLabel)
demographic.ARVR_exp
## # A tibble: 3 × 5
## Exp_ARVR count percentage label Previous AR/VR exper…¹
## <chr> <int> <dbl> <chr> <fct>
## 1 Beginner (less than 5 hours exp… 4 33.3 33.3% Beginner (less than 5…
## 2 Familiar (5-20 hours experience) 3 25 25% Familiar (5-20 hours …
## 3 I have no experience 5 41.7 41.7% No experience
## # ℹ abbreviated name: ¹​`Previous AR/VR experience`
# Participants' previous AR/VR experience distribution chart
ggplot(demographic.ARVR_exp, aes(x = "", y = count, fill = `Previous AR/VR experience`)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
geom_text(aes(label = label), position = position_stack(vjust = 0.5), size = 4) +
labs(title = "Distribution of Participants Previous AR/VR Experience") +
theme_void()
# Participants' previous globe experience distribution
demographic.globes_exp <- demographic %>%
select(UserID, Globe_usage_frequency) %>%
distinct() %>%
group_by(Globe_usage_frequency) %>%
summarise(count = n()) %>%
mutate(percentage = round(count / sum(count) * 100, 1),
graph_label = paste0(percentage, "%")) %>%
rename(`Previous globes experience` = Globe_usage_frequency)
demographic.globes_exp
## # A tibble: 3 × 4
## `Previous globes experience` count percentage graph_label
## <chr> <int> <dbl> <chr>
## 1 A few times a month 1 8.3 8.3%
## 2 A few times a year 3 25 25%
## 3 Once every few years 8 66.7 66.7%
# Participants' previous globe experience distribution chart
ggplot(demographic.globes_exp, aes(x = "", y = count, fill = `Previous globes experience`)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
geom_text(aes(label = graph_label), position = position_stack(vjust = 0.5), size = 4) +
labs(title = "Distribution of Participants Previous AR/VR Experience") +
theme_void()
# Participants' previous Apple Vision Pro Experience distribution
demographic.visionpro_exp <- demographic %>%
select(UserID, Have_used_VisionPro) %>%
distinct() %>%
group_by(Have_used_VisionPro) %>%
summarise(count = n()) %>%
mutate(
percentage = round(count / sum(count) * 100, 1),
graph_label = paste0(percentage, "%")
) %>%
rename(`Have used Apple Vision Pro` = Have_used_VisionPro)
demographic.visionpro_exp
## # A tibble: 2 × 4
## `Have used Apple Vision Pro` count percentage graph_label
## <chr> <int> <dbl> <chr>
## 1 I have never used the Apple Vision Pro 11 91.7 91.7%
## 2 I have used the Apple Vision Pro once or twice 1 8.3 8.3%
# Participants' previous Apple Vision Pro Experience distribution chart
ggplot(demographic.visionpro_exp, aes(x = "", y = count, fill = `Have used Apple Vision Pro`)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
geom_text(aes(label = graph_label), position = position_stack(vjust = 0.5), size = 4) +
labs(title = "Distribution of Participants Previous AR/VR Experience") +
theme_void()
Notes: Use boxplot instead of bar chart Add technique column
Structure it like this:
data.positioning <- data %>%
inner_join(demographic, by = "UserID") %>%
inner_join(positioning_NRG, by = "UserID") %>%
rename(
PAAS_NRG = Mentally_demanding,
BORG_NRG = Physically_demanding
) %>%
mutate(
PAAS_NRG = as.numeric(str_extract(PAAS_NRG, "\\d+(\\.\\d+)?")),
BORG_NRG = as.numeric(str_extract(BORG_NRG, "\\d+(\\.\\d+)?"))
) %>%
inner_join(positioning_RG, by = "UserID") %>%
rename(
PAAS_RG = Mentally_demanding,
BORG_RG = Physically_demanding
) %>%
mutate(
PAAS_RG = as.numeric(str_extract(PAAS_RG, "\\d+(\\.\\d+)?")),
BORG_RG = as.numeric(str_extract(BORG_RG, "\\d+(\\.\\d+)?"))
) %>%
inner_join(positioning_preference, by = "UserID") %>%
rename(
behaviour_preference = Positioning_preference,
behaviour_feedback = Positioning_feedback
) %>%
mutate(
behaviour_preference = case_when(
str_detect(behaviour_preference, "Static orientation") ~ "staticOrientation",
str_detect(behaviour_preference, "Adaptive orientation") ~ "adaptiveOrientation",
str_detect(behaviour_preference, "no preference") ~ "noPreference",
TRUE ~ "unknown"
) ) %>%
filter(Type == "positionTask") %>%
select(UserID, TaskID, ActionID, rotateGlobeWhileDragging, distance, direction, Date, ActionStatus, main_translation_x,
main_translation_y, main_translation_z, target_translation_x, target_translation_y, target_translation_z,
match_accuracy_result, status, PAAS_NRG, BORG_NRG, PAAS_RG, BORG_RG, behaviour_preference, behaviour_feedback) %>%
mutate(positionCondition = if_else(rotateGlobeWhileDragging, "rotatingGlobe", "nonRotatingGlobe")) %>%
select(-rotateGlobeWhileDragging) %>%
mutate(distance = as.factor(distance),
direction = as.factor(direction),
positionCondition = as.factor(positionCondition),
status = as.factor(status),
behaviour_preference = as.factor(behaviour_preference))
### Accuracy
#### Normality
data.positioning.matched <- data.positioning %>%
filter(status == "Matched")
shapiro.test(data.positioning.matched$match_accuracy_result)
##
## Shapiro-Wilk normality test
##
## data: data.positioning.matched$match_accuracy_result
## W = 0.97029, p-value = 2.086e-09
hist(data.positioning.matched$match_accuracy_result, breaks = 100,
main = "Histogram (Zoomed)", xlab = "Accuracy",
col = "lightblue", xlim = c(0, 0.06))
plot(density(data.positioning.matched$match_accuracy_result),
main = "Density Plot (Zoomed)", xlab = "Accuracy",
col = "blue", lwd = 2, xlim = c(0, 0.6))
# Although the w value is close to 1, the p value is below 0.05 so we reject null hypothesis that the data is normally distributed
# So, we cannot use one way ANOVA, instead, we use Wilcoxon signed-rank test
#### Statistical tests
data.positioning.matched.accuracy_avg.long <- data.positioning.matched %>%
group_by(UserID, positionCondition) %>%
summarise(mean_accuracy = mean(match_accuracy_result, na.rm = TRUE), .groups = 'drop')
data.positioning.matched.art <- art(mean_accuracy ~ positionCondition + (1|UserID), data = data.positioning.matched.accuracy_avg.long)
anova(data.positioning.matched.art)
## Analysis of Variance of Aligned Rank Transformed Data
##
## Table Type: Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df)
## Model: Mixed Effects (lmer)
## Response: art(mean_accuracy)
##
## F Df Df.res Pr(>F)
## 1 positionCondition 0.33588 1 11 0.5739
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Factor tested: positionCondition (e.g., rotatingGlobe vs nonRotatingGlobe)
# F-statistic: 0.33588 — this tells us the ratio of variance between the groups to the variance within groups (after aligned rank transformation).
# Degrees of freedom (df): 1 for the factor, and 11 for the residuals (which likely means 12 participants).
# p-value: 0.5739 — this is not statistically significant at any common threshold (e.g., 0.05).
# An ART ANOVA revealed no significant effect of position condition (rotating vs non-rotating) on match accuracy, F(1, 11) = 0.34, p = .574.
ggplot(data.positioning.matched.accuracy_avg.long, aes(x = positionCondition, y = mean_accuracy, group = UserID)) +
geom_line(aes(color = as.factor(UserID))) +
geom_point(size = 3) +
labs(title = "Paired Accuracy: Moving vs Non-Moving Globe",
x = "Condition",
y = "Match Accuracy") +
theme_minimal()
ggplot(data.positioning.matched.accuracy_avg.long, aes(x = positionCondition, y = mean_accuracy)) +
geom_boxplot(outlier.shape = NA, fill = "lightblue") +
geom_jitter(width = 0.1, size = 2, alpha = 0.7) +
labs(title = "Accuracy by Globe Movement Condition",
x = "Condition",
y = "Match Accuracy") +
theme_minimal()
### Completion Time
data.positioning.taskCompletion_avg <- data.positioning %>%
group_by(UserID, TaskID) %>%
summarise(
completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
.groups = "drop"
)
shapiro.test(data.positioning.taskCompletion_avg$completion_time)
##
## Shapiro-Wilk normality test
##
## data: data.positioning.taskCompletion_avg$completion_time
## W = 0.59479, p-value < 2.2e-16
data.positioning.taskCompletion_avg.long <- data.positioning %>%
group_by(UserID, positionCondition, TaskID) %>%
summarise(
completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
.groups = "drop"
) %>%
group_by(UserID, positionCondition) %>%
summarise(
avg_completion_time = mean(completion_time),
.groups = "drop"
)
# %>%
# pivot_wider(names_from = positionCondition, values_from = avg_completion_time)
# wilcox.test(
# data.positioning.taskCompletion_avg.wide$rotatingGlobe,
# data.positioning.taskCompletion_avg.wide$nonRotatingGlobe,
# paired = TRUE,
# alternative = "two.sided"
# )
data.positioning.taskCompletion_avg.art <- art(avg_completion_time ~ positionCondition + (1|UserID), data = data.positioning.taskCompletion_avg.long)
anova(data.positioning.taskCompletion_avg.art)
## Analysis of Variance of Aligned Rank Transformed Data
##
## Table Type: Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df)
## Model: Mixed Effects (lmer)
## Response: art(avg_completion_time)
##
## F Df Df.res Pr(>F)
## 1 positionCondition 0.26366 1 11 0.61777
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# The test statistic is F(1, 11) = 0.264, with a p-value of 0.618.
# Since p > 0.05, the result is not statistically significant.
# This means that there is no evidence of a significant effect of positionCondition on avg_completion_time.
#
# An aligned rank transform ANOVA showed that position condition did not significantly affect average task completion time, F(1, 11) = 0.26, p = .618.
# data.positioning.taskCompletion_avg.long <- data.positioning.taskCompletion_avg.wide %>%
# pivot_longer(cols = c(rotatingGlobe, nonRotatingGlobe),
# names_to = "Condition",
# values_to = "completion_time")
ggplot(data.positioning.taskCompletion_avg.long, aes(x = positionCondition, y = avg_completion_time, group = UserID)) +
geom_line(aes(color = as.factor(UserID)), linewidth = 1, alpha = 0.6) +
geom_point(size = 3) +
labs(
title = "Task Completion Time by Condition",
x = "Condition",
y = "Completion Time (minutes)",
color = "UserID"
) +
theme_minimal()
ggplot(data.positioning.taskCompletion_avg.long, aes(x = positionCondition, y = avg_completion_time)) +
geom_boxplot(outlier.shape = NA, fill = "lightblue") +
geom_jitter(width = 0.1, size = 2, alpha = 0.7) +
labs(title = "Accuracy by Globe Movement Condition",
x = "Condition",
y = "Match Accuracy") +
theme_minimal()
### Subjective Measures
#### Physical Exertion
# Spearman’s rank correlation is a non-parametric test.
# It does not assume normal distribution of the variables.
# It works on ranks of the data, not the raw values — so it’s robust against skewed or non-normal distributions.
data.positioning.matched.RG <- data.positioning.matched %>%
filter(positionCondition == "rotatingGlobe")
cor.test(data.positioning.matched.RG$BORG_RG,
data.positioning.matched.RG$match_accuracy_result, method = "spearman")
## Warning in cor.test.default(data.positioning.matched.RG$BORG_RG,
## data.positioning.matched.RG$match_accuracy_result, : Cannot compute exact
## p-value with ties
##
## Spearman's rank correlation rho
##
## data: data.positioning.matched.RG$BORG_RG and data.positioning.matched.RG$match_accuracy_result
## S = 3447428, p-value = 0.02285
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.1340871
ggplot(data.positioning.matched.RG, aes(x = BORG_RG, y = match_accuracy_result)) +
geom_point(color = "steelblue", size = 2, alpha = 0.7) +
geom_smooth(method = "loess", color = "darkred", se = TRUE) +
labs(
title = "Correlation between Physical Exertion and Accuracy (Rotating Globe)",
x = "Physical Exertion (BORG_RG)",
y = "Match Accuracy Result"
) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
data.positioning.matched.NRG <- data.positioning.matched %>%
filter(positionCondition == "nonRotatingGlobe")
cor.test(data.positioning.matched.NRG$BORG_NRG,
data.positioning.matched.NRG$match_accuracy_result, method = "spearman")
## Warning in cor.test.default(data.positioning.matched.NRG$BORG_NRG,
## data.positioning.matched.NRG$match_accuracy_result, : Cannot compute exact
## p-value with ties
##
## Spearman's rank correlation rho
##
## data: data.positioning.matched.NRG$BORG_NRG and data.positioning.matched.NRG$match_accuracy_result
## S = 3491838, p-value = 0.03706
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.1229323
data.positioning.taskCompletion_avg.RG <- data.positioning %>%
group_by(UserID, positionCondition, BORG_RG, TaskID) %>%
summarise(
completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
.groups = "drop"
) %>%
filter(positionCondition == "rotatingGlobe")
cor.test(data.positioning.taskCompletion_avg.RG$BORG_RG,
data.positioning.taskCompletion_avg.RG$completion_time, method = "spearman")
## Warning in cor.test.default(data.positioning.taskCompletion_avg.RG$BORG_RG, :
## Cannot compute exact p-value with ties
##
## Spearman's rank correlation rho
##
## data: data.positioning.taskCompletion_avg.RG$BORG_RG and data.positioning.taskCompletion_avg.RG$completion_time
## S = 3103888, p-value = 0.0001632
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.2203763
data.positioning.taskCompletion_avg.NRG <- data.positioning %>%
group_by(UserID, positionCondition, BORG_NRG, TaskID) %>%
summarise(
completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
.groups = "drop"
) %>%
filter(positionCondition == "nonRotatingGlobe")
cor.test(data.positioning.taskCompletion_avg.NRG$BORG_NRG,
data.positioning.taskCompletion_avg.NRG$completion_time, method = "spearman")
## Warning in cor.test.default(data.positioning.taskCompletion_avg.NRG$BORG_NRG, :
## Cannot compute exact p-value with ties
##
## Spearman's rank correlation rho
##
## data: data.positioning.taskCompletion_avg.NRG$BORG_NRG and data.positioning.taskCompletion_avg.NRG$completion_time
## S = 4081328, p-value = 0.671
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## -0.02513373
# BORG vs Accuracy
data.positioning.matched.RG$condition <- "RG"
data.positioning.matched.NRG$condition <- "NRG"
data.positioning.matched.combined <- bind_rows(
data.positioning.matched.RG %>% rename(BORG = BORG_RG),
data.positioning.matched.NRG %>% rename(BORG = BORG_NRG)
)
ggplot(data.positioning.matched.combined, aes(x = BORG, y = match_accuracy_result, color = condition)) +
geom_point(alpha = 0.7) +
geom_smooth(method = "lm", se = TRUE) +
labs(
title = "Physical Exertion vs Match Accuracy",
x = "BORG Scale",
y = "Match Accuracy",
color = "Condition"
) +
scale_color_manual(values = c("RG" = "blue", "NRG" = "red")) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
# BORG vs Completion Time
data.positioning.taskCompletion_avg.RG$condition <- "RG"
data.positioning.taskCompletion_avg.NRG$condition <- "NRG"
data.positioning.taskCompletion_avg.combined <- bind_rows(
data.positioning.taskCompletion_avg.RG %>%
rename(BORG = BORG_RG),
data.positioning.taskCompletion_avg.NRG %>%
rename(BORG = BORG_NRG)
)
ggplot(data.positioning.taskCompletion_avg.combined, aes(x = BORG, y = completion_time, color = condition)) +
geom_point(alpha = 0.7) +
geom_smooth(method = "lm", se = TRUE) +
labs(
title = "Physical Exertion vs Completion Time",
x = "BORG Scale",
y = "Completion Time (min)",
color = "Condition"
) +
scale_color_manual(values = c("RG" = "blue", "NRG" = "red")) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
#### Preference
data.positioning %>%
select(UserID, behaviour_preference) %>%
distinct() %>%
count(behaviour_preference) %>%
mutate(
percent = n / sum(n),
ncount = paste0(n, "\n", percent_format()(percent))
) %>%
ggplot(aes(x = "", y = n, fill = behaviour_preference)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
geom_text(aes(label = ncount), position = position_stack(vjust = 0.5), size = 4) +
labs(
title = "Distribution of Positioning Behaviour Preferences",
fill = "Preference"
) +
theme_void()
#### Comments
### Summary
data.rotating <- data %>%
inner_join(demographic, by = "UserID") %>%
inner_join(rotation_OH, by = "UserID") %>%
rename(
PAAS_OH = Mentally_demanding,
BORG_OH = Physically_demanding
) %>%
mutate(
PAAS_OH = as.numeric(str_extract(PAAS_OH, "\\d+(\\.\\d+)?")),
BORG_OH = as.numeric(str_extract(BORG_OH, "\\d+(\\.\\d+)?"))
) %>%
inner_join(rotation_TH, by = "UserID") %>%
rename(
PAAS_TH = Mentally_demanding,
BORG_TH = Physically_demanding
) %>%
mutate(
PAAS_TH = as.numeric(str_extract(PAAS_TH, "\\d+(\\.\\d+)?")),
BORG_TH = as.numeric(str_extract(BORG_TH, "\\d+(\\.\\d+)?"))
) %>%
inner_join(rotation_preference, by = "UserID") %>%
rename(
behaviour_preference = Rotation_preference,
behaviour_feedback = Rotation_feedback
) %>%
mutate(
behaviour_preference = case_when(
str_detect(behaviour_preference, "One-handed") ~ "oneHandedPreference",
str_detect(behaviour_preference, "Two-handed") ~ "twoHandedPreference",
str_detect(behaviour_preference, "no preference") ~ "noPreference",
TRUE ~ "unknown"
)) %>%
filter(Type == "rotationTask") %>%
select(UserID, TaskID, ActionID, oneHandedRotationGesture, complexity, Date, ActionStatus, main_rotation_x,
main_rotation_y, main_rotation_z, main_rotation_w, target_rotation_x, target_rotation_y, target_rotation_z,
target_rotation_w,match_accuracy_result, status, PAAS_OH, BORG_OH, PAAS_TH, BORG_TH, behaviour_preference, behaviour_feedback) %>%
mutate(rotationCondition = if_else(oneHandedRotationGesture, "oneHanded", "twoHanded")) %>%
select(-oneHandedRotationGesture) %>%
mutate(complexity = as.factor(complexity),
rotationCondition = as.factor(rotationCondition),
status = as.factor(status),
behaviour_preference = as.factor(behaviour_preference))
### Accuracy
#### Normality
data.rotating.matched <- data.rotating %>%
filter(status == "Matched")
shapiro.test(data.rotating.matched$match_accuracy_result)
##
## Shapiro-Wilk normality test
##
## data: data.rotating.matched$match_accuracy_result
## W = 0.94156, p-value = 5.023e-07
hist(data.rotating.matched$match_accuracy_result, breaks = 100,
main = "Histogram (Zoomed)", xlab = "Accuracy",
col = "lightblue", xlim = c(0, 0.5))
plot(density(data.rotating.matched$match_accuracy_result),
main = "Density Plot (Zoomed)", xlab = "Accuracy",
col = "blue", lwd = 2, xlim = c(0, 0.5))
# Although the w value is close to 1, the p value is below 0.05 so we reject null hypothesis that the data is normally distributed
# So, we cannot use one way ANOVA, instead, we use Wilcoxon signed-rank test
#### Statistical tests
data.rotating.matched.accuracy_avg.long <- data.rotating.matched %>%
group_by(UserID, rotationCondition) %>%
summarise(mean_accuracy = mean(match_accuracy_result, na.rm = TRUE), .groups = 'drop')
data.rotating.matched.art <- art(mean_accuracy ~ rotationCondition + (1|UserID), data = data.rotating.matched.accuracy_avg.long)
anova(data.rotating.matched.art)
## boundary (singular) fit: see help('isSingular')
## Analysis of Variance of Aligned Rank Transformed Data
##
## Table Type: Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df)
## Model: Mixed Effects (lmer)
## Response: art(mean_accuracy)
##
## F Df Df.res Pr(>F)
## 1 rotationCondition 6.2209 1 11 0.029814 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Because p < .05, the result is considered statistically significant.
# Therefore, we reject the null hypothesis and conclude that rotation affects accuracy.
# An ART ANOVA revealed a significant main effect of rotation condition on mean accuracy, F(1, 11) = 6.22, p = .030, indicating that the presence of globe rotation influenced the participants’ accuracy during the task.
ggplot(data.rotating.matched.accuracy_avg.long, aes(x = rotationCondition, y = mean_accuracy, group = UserID)) +
geom_line(aes(color = as.factor(UserID))) +
geom_point(size = 3) +
labs(title = "Paired Accuracy: Moving vs Non-Moving Globe",
x = "Condition",
y = "Match Accuracy") +
theme_minimal()
ggplot(data.rotating.matched.accuracy_avg.long, aes(x = rotationCondition, y = mean_accuracy)) +
geom_boxplot(outlier.shape = NA, fill = "lightblue") +
geom_jitter(width = 0.1, size = 2, alpha = 0.7) +
labs(title = "Accuracy by Globe Movement Condition",
x = "Condition",
y = "Match Accuracy") +
theme_minimal()
### Completion Time
data.rotating.taskCompletion_avg <- data.rotating %>%
group_by(UserID, TaskID) %>%
summarise(
completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
.groups = "drop"
)
shapiro.test(data.rotating.taskCompletion_avg$completion_time)
##
## Shapiro-Wilk normality test
##
## data: data.rotating.taskCompletion_avg$completion_time
## W = 0.49195, p-value < 2.2e-16
data.rotating.taskCompletion_avg.long <- data.rotating %>%
group_by(UserID, rotationCondition, TaskID) %>%
summarise(
completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
.groups = "drop"
) %>%
group_by(UserID, rotationCondition) %>%
summarise(
avg_completion_time = mean(completion_time),
.groups = "drop"
)
data.rotating.taskCompletion_avg.art <- art(avg_completion_time ~ rotationCondition + (1|UserID), data = data.rotating.taskCompletion_avg.long)
anova(data.rotating.taskCompletion_avg.art)
## Analysis of Variance of Aligned Rank Transformed Data
##
## Table Type: Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df)
## Model: Mixed Effects (lmer)
## Response: art(avg_completion_time)
##
## F Df Df.res Pr(>F)
## 1 rotationCondition 6.4517 1 11 0.027479 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# F(1, 11) = 6.45, p = 0.027
# Since the p-value is less than 0.05, the result is statistically significant.
# This means that rotationCondition has a significant effect on avg_completion_time.
#
# An aligned rank transform ANOVA revealed a significant effect of rotation condition on task completion time, F(1, 11) = 6.45, p = .027.
ggplot(data.rotating.taskCompletion_avg.long, aes(x = rotationCondition, y = avg_completion_time, group = UserID)) +
geom_line(aes(color = as.factor(UserID)), linewidth = 1, alpha = 0.6) +
geom_point(size = 3) +
labs(
title = "Task Completion Time by Condition",
x = "Condition",
y = "Completion Time (minutes)",
color = "UserID"
) +
theme_minimal()
ggplot(data.rotating.taskCompletion_avg.long, aes(x = rotationCondition, y = avg_completion_time)) +
geom_boxplot(outlier.shape = NA, fill = "lightblue") +
geom_jitter(width = 0.1, size = 2, alpha = 0.7) +
labs(title = "Accuracy by Globe Movement Condition",
x = "Condition",
y = "Match Accuracy") +
theme_minimal()
### Subjective Measures
#### Physical Exertion
# Spearman’s rank correlation is a non-parametric test.
# It does not assume normal distribution of the variables.
# It works on ranks of the data, not the raw values — so it’s robust against skewed or non-normal distributions.
data.rotating.matched.OH <- data.rotating.matched %>%
filter(rotationCondition == "oneHanded")
cor.test(data.rotating.matched.OH$BORG_OH,
data.rotating.matched.OH$match_accuracy_result, method = "spearman")
## Warning in cor.test.default(data.rotating.matched.OH$BORG_OH,
## data.rotating.matched.OH$match_accuracy_result, : Cannot compute exact p-value
## with ties
##
## Spearman's rank correlation rho
##
## data: data.rotating.matched.OH$BORG_OH and data.rotating.matched.OH$match_accuracy_result
## S = 152593, p-value = 0.7353
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## -0.0349492
ggplot(data.rotating.matched.OH, aes(x = BORG_OH, y = match_accuracy_result)) +
geom_point(color = "steelblue", size = 2, alpha = 0.7) +
geom_smooth(method = "loess", color = "darkred", se = TRUE) +
labs(
title = "Correlation between Physical Exertion and Accuracy (Rotating Globe)",
x = "Physical Exertion (BOOH_OH)",
y = "Match Accuracy Result"
) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 1
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 1
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 5.4581e-17
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at 1
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius 1
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 5.4581e-17
data.rotating.matched.TH <- data.rotating.matched %>%
filter(rotationCondition == "twoHanded")
cor.test(data.rotating.matched.TH$BORG_TH,
data.rotating.matched.TH$match_accuracy_result, method = "spearman")
## Warning in cor.test.default(data.rotating.matched.TH$BORG_TH,
## data.rotating.matched.TH$match_accuracy_result, : Cannot compute exact p-value
## with ties
##
## Spearman's rank correlation rho
##
## data: data.rotating.matched.TH$BORG_TH and data.rotating.matched.TH$match_accuracy_result
## S = 133640, p-value = 0.3644
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.09359448
data.rotating.taskCompletion_avg.OH <- data.rotating %>%
group_by(UserID, rotationCondition, BORG_OH, TaskID) %>%
summarise(
completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
.groups = "drop"
) %>%
filter(rotationCondition == "oneHanded")
cor.test(data.rotating.taskCompletion_avg.OH$BORG_OH,
data.rotating.taskCompletion_avg.OH$completion_time, method = "spearman")
## Warning in cor.test.default(data.rotating.taskCompletion_avg.OH$BORG_OH, :
## Cannot compute exact p-value with ties
##
## Spearman's rank correlation rho
##
## data: data.rotating.taskCompletion_avg.OH$BORG_OH and data.rotating.taskCompletion_avg.OH$completion_time
## S = 139512, p-value = 0.6029
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.05376892
data.rotating.taskCompletion_avg.TH <- data.rotating %>%
group_by(UserID, rotationCondition, BORG_TH, TaskID) %>%
summarise(
completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
.groups = "drop"
) %>%
filter(rotationCondition == "twoHanded")
cor.test(data.rotating.taskCompletion_avg.TH$BORG_TH,
data.rotating.taskCompletion_avg.TH$completion_time, method = "spearman")
## Warning in cor.test.default(data.rotating.taskCompletion_avg.TH$BORG_TH, :
## Cannot compute exact p-value with ties
##
## Spearman's rank correlation rho
##
## data: data.rotating.taskCompletion_avg.TH$BORG_TH and data.rotating.taskCompletion_avg.TH$completion_time
## S = 131579, p-value = 0.2968
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.1075767
# BORG vs Accuracy
data.rotating.matched.OH$condition <- "OH"
data.rotating.matched.TH$condition <- "TH"
data.rotating.matched.combined <- bind_rows(
data.rotating.matched.OH %>% rename(BORG = BORG_OH),
data.rotating.matched.TH %>% rename(BORG = BORG_TH)
)
ggplot(data.rotating.matched.combined, aes(x = BORG, y = match_accuracy_result, color = condition)) +
geom_point(alpha = 0.7) +
geom_smooth(method = "lm", se = TRUE) +
labs(
title = "Physical Exertion vs Match Accuracy",
x = "BORG Scale",
y = "Match Accuracy",
color = "Condition"
) +
scale_color_manual(values = c("OH" = "blue", "TH" = "red")) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
# BORG vs Completion Time
data.rotating.taskCompletion_avg.OH$condition <- "OH"
data.rotating.taskCompletion_avg.TH$condition <- "TH"
data.rotating.taskCompletion_avg.combined <- bind_rows(
data.rotating.taskCompletion_avg.OH %>%
rename(BORG = BORG_OH),
data.rotating.taskCompletion_avg.TH %>%
rename(BORG = BORG_TH)
)
ggplot(data.rotating.taskCompletion_avg.combined, aes(x = BORG, y = completion_time, color = condition)) +
geom_point(alpha = 0.7) +
geom_smooth(method = "lm", se = TRUE) +
labs(
title = "Physical Exertion vs Completion Time",
x = "BORG Scale",
y = "Completion Time (min)",
color = "Condition"
) +
scale_color_manual(values = c("OH" = "blue", "TH" = "red")) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
#### Preference
data.rotating %>%
select(UserID, behaviour_preference) %>%
distinct() %>%
count(behaviour_preference) %>%
mutate(
percent = n / sum(n),
ncount = paste0(n, "\n", percent_format()(percent))
) %>%
ggplot(aes(x = "", y = n, fill = behaviour_preference)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
geom_text(aes(label = ncount), position = position_stack(vjust = 0.5), size = 4) +
labs(
title = "Distribution of Rotation Behaviour Preferences",
fill = "Preference"
) +
theme_void()
#### Comments
### Summary
data.scale <- data %>%
inner_join(demographic, by = "UserID") %>%
inner_join(scale_MG, by = "UserID") %>%
rename(
PAAS_MG = Mentally_demanding,
BORG_MG = Physically_demanding
) %>%
mutate(
PAAS_MG = as.numeric(str_extract(PAAS_MG, "\\d+(\\.\\d+)?")),
BORG_MG = as.numeric(str_extract(BORG_MG, "\\d+(\\.\\d+)?"))
) %>%
inner_join(scale_NMG, by = "UserID") %>%
rename(
PAAS_NMG = Mentally_demanding,
BORG_NMG = Physically_demanding
) %>%
mutate(
PAAS_NMG = as.numeric(str_extract(PAAS_NMG, "\\d+(\\.\\d+)?")),
BORG_NMG = as.numeric(str_extract(BORG_NMG, "\\d+(\\.\\d+)?"))
) %>%
inner_join(scale_preference, by = "UserID") %>%
rename(
behaviour_preference = Scale_preference,
behaviour_feedback = Scale_feedback
) %>%
mutate(
behaviour_preference = case_when(
str_detect(behaviour_preference, "Maintain distance") ~ "maintainDistance",
str_detect(behaviour_preference, "Maintain globe") ~ "maintainGlobe",
str_detect(behaviour_preference, "no preference") ~ "noPreference",
TRUE ~ "unknown"
)) %>%
filter(Type == "scaleTask") %>%
select(UserID, TaskID, ActionID, moveGlobeWhileScaling, zoomDirection, Date, ActionStatus, main_scale_x,
main_scale_y, main_scale_z, target_scale_x, target_scale_y, target_scale_z, match_accuracy_result, status,
PAAS_MG, BORG_MG, PAAS_NMG, BORG_NMG, behaviour_preference, behaviour_feedback) %>%
mutate(scaleCondition = if_else(moveGlobeWhileScaling, "movingGlobe", "nonMovingGlobe")) %>%
select(-moveGlobeWhileScaling) %>%
mutate(zoomDirection = as.factor(zoomDirection),
scaleCondition = as.factor(scaleCondition),
status = as.factor(status),
behaviour_preference = as.factor(behaviour_preference))
### Accuracy
#### Normality
data.scale.matched <- data.scale %>%
filter(status == "Matched")
shapiro.test(data.scale.matched$match_accuracy_result)
##
## Shapiro-Wilk normality test
##
## data: data.scale.matched$match_accuracy_result
## W = 0.94732, p-value = 1.64e-06
hist(data.scale.matched$match_accuracy_result, breaks = 100,
main = "Histogram (Zoomed)", xlab = "Accuracy",
col = "lightblue", xlim = c(0, 0.5))
plot(density(data.scale.matched$match_accuracy_result),
main = "Density Plot (Zoomed)", xlab = "Accuracy",
col = "blue", lwd = 2, xlim = c(0, 0.5))
# Although the w value is close to 1, the p value is below 0.05 so we reject null hypothesis that the data is normally distributed
# So, we cannot use one way ANOVA, instead, we use Wilcoxon signed-rank test
#### Statistical tests
data.scale.matched.accuracy_avg.long <- data.scale.matched %>%
group_by(UserID, scaleCondition) %>%
summarise(mean_accuracy = mean(match_accuracy_result, na.rm = TRUE), .groups = 'drop')
# %>%
# pivot_wider(names_from = scaleCondition, values_from = mean_accuracy)
data.scale.matched.art <- art(mean_accuracy ~ scaleCondition + (1|UserID), data = data.scale.matched.accuracy_avg.long)
anova(data.scale.matched.art)
## Analysis of Variance of Aligned Rank Transformed Data
##
## Table Type: Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df)
## Model: Mixed Effects (lmer)
## Response: art(mean_accuracy)
##
## F Df Df.res Pr(>F)
## 1 scaleCondition 0.43825 1 11 0.5216
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Because p > .05, we fail to reject the null hypothesis.
# There is no evidence that changing the scale condition affects how accurately participants performed.
# An ART ANOVA showed no significant effect of scale condition on mean accuracy, F(1, 11) = 0.44, p = .522, indicating that changing the scale of the globe did not impact participants’ accuracy.
ggplot(data.scale.matched.accuracy_avg.long, aes(x = scaleCondition, y = mean_accuracy, group = UserID)) +
geom_line(aes(color = as.factor(UserID))) +
geom_point(size = 3) +
labs(title = "Paired Accuracy: Moving vs Non-Moving Globe",
x = "Condition",
y = "Match Accuracy") +
theme_minimal()
ggplot(data.scale.matched.accuracy_avg.long, aes(x = scaleCondition, y = mean_accuracy)) +
geom_boxplot(outlier.shape = NA, fill = "lightblue") +
geom_jitter(width = 0.1, size = 2, alpha = 0.7) +
labs(title = "Accuracy by Globe Movement Condition",
x = "Condition",
y = "Match Accuracy") +
theme_minimal()
### Completion Time
data.scale.taskCompletion_avg <- data.scale %>%
group_by(UserID, TaskID) %>%
summarise(
completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
.groups = "drop"
)
shapiro.test(data.scale.taskCompletion_avg$completion_time)
##
## Shapiro-Wilk normality test
##
## data: data.scale.taskCompletion_avg$completion_time
## W = 0.69808, p-value < 2.2e-16
data.scale.taskCompletion_avg.long <- data.scale %>%
group_by(UserID, scaleCondition, TaskID) %>%
summarise(
completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
.groups = "drop"
) %>%
group_by(UserID, scaleCondition) %>%
summarise(
avg_completion_time = mean(completion_time),
.groups = "drop"
)
# %>%
# pivot_wider(names_from = scaleCondition, values_from = avg_completion_time)
data.scale.taskCompletion.art <- art(avg_completion_time ~ scaleCondition + (1|UserID), data = data.scale.taskCompletion_avg.long)
anova(data.scale.matched.art)
## Analysis of Variance of Aligned Rank Transformed Data
##
## Table Type: Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df)
## Model: Mixed Effects (lmer)
## Response: art(mean_accuracy)
##
## F Df Df.res Pr(>F)
## 1 scaleCondition 0.43825 1 11 0.5216
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# An aligned rank transform (ART) ANOVA revealed no significant effect of scale condition on mean accuracy, F(1, 11) = 0.44, p = .522.
# There was no significant effect of scale condition on mean accuracy, F(1, 11) = 0.44, p = .522.
# wilcox.test(
# data.scale.taskCompletion_avg.wide$movingGlobe,
# data.scale.taskCompletion_avg.wide$nonMovingGlobe,
# paired = TRUE,
# alternative = "two.sided"
# )
# data.scale.taskCompletion_avg.long <- data.scale.taskCompletion_avg.wide %>%
# pivot_longer(cols = c(movingGlobe, nonMovingGlobe),
# names_to = "Condition",
# values_to = "completion_time")
ggplot(data.scale.taskCompletion_avg.long, aes(x = scaleCondition, y = avg_completion_time, group = UserID)) +
geom_line(aes(color = as.factor(UserID)), linewidth = 1, alpha = 0.6) +
geom_point(size = 3) +
labs(
title = "Task Completion Time by Condition",
x = "Condition",
y = "Completion Time (minutes)",
color = "UserID"
) +
theme_minimal()
ggplot(data.scale.taskCompletion_avg.long, aes(x = scaleCondition, y = avg_completion_time)) +
geom_boxplot(outlier.shape = NA, fill = "lightblue") +
geom_jitter(width = 0.1, size = 2, alpha = 0.7) +
labs(title = "Accuracy by Globe Movement Condition",
x = "Condition",
y = "Match Accuracy") +
theme_minimal()
### Subjective Measures
#### Physical Exertion
# Spearman’s rank correlation is a non-parametric test.
# It does not assume normal distribution of the variables.
# It works on ranks of the data, not the raw values — so it’s robust against skewed or non-normal distributions.
data.positioning.matched.RG <- data.positioning.matched %>%
filter(positionCondition == "rotatingGlobe")
cor.test(data.positioning.matched.RG$BORG_RG,
data.positioning.matched.RG$match_accuracy_result, method = "spearman")
## Warning in cor.test.default(data.positioning.matched.RG$BORG_RG,
## data.positioning.matched.RG$match_accuracy_result, : Cannot compute exact
## p-value with ties
##
## Spearman's rank correlation rho
##
## data: data.positioning.matched.RG$BORG_RG and data.positioning.matched.RG$match_accuracy_result
## S = 3447428, p-value = 0.02285
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.1340871
ggplot(data.positioning.matched.RG, aes(x = BORG_RG, y = match_accuracy_result)) +
geom_point(color = "steelblue", size = 2, alpha = 0.7) +
geom_smooth(method = "loess", color = "darkred", se = TRUE) +
labs(
title = "Correlation between Physical Exertion and Accuracy (Rotating Globe)",
x = "Physical Exertion (BORG_RG)",
y = "Match Accuracy Result"
) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
data.positioning.matched.NRG <- data.positioning.matched %>%
filter(positionCondition == "nonRotatingGlobe")
cor.test(data.positioning.matched.NRG$BORG_NRG,
data.positioning.matched.NRG$match_accuracy_result, method = "spearman")
## Warning in cor.test.default(data.positioning.matched.NRG$BORG_NRG,
## data.positioning.matched.NRG$match_accuracy_result, : Cannot compute exact
## p-value with ties
##
## Spearman's rank correlation rho
##
## data: data.positioning.matched.NRG$BORG_NRG and data.positioning.matched.NRG$match_accuracy_result
## S = 3491838, p-value = 0.03706
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.1229323
data.positioning.taskCompletion_avg.RG <- data.positioning %>%
group_by(UserID, positionCondition, BORG_RG, TaskID) %>%
summarise(
completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
.groups = "drop"
) %>%
filter(positionCondition == "rotatingGlobe")
cor.test(data.positioning.taskCompletion_avg.RG$BORG_RG,
data.positioning.taskCompletion_avg.RG$completion_time, method = "spearman")
## Warning in cor.test.default(data.positioning.taskCompletion_avg.RG$BORG_RG, :
## Cannot compute exact p-value with ties
##
## Spearman's rank correlation rho
##
## data: data.positioning.taskCompletion_avg.RG$BORG_RG and data.positioning.taskCompletion_avg.RG$completion_time
## S = 3103888, p-value = 0.0001632
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.2203763
data.positioning.taskCompletion_avg.NRG <- data.positioning %>%
group_by(UserID, positionCondition, BORG_NRG, TaskID) %>%
summarise(
completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
.groups = "drop"
) %>%
filter(positionCondition == "nonRotatingGlobe")
cor.test(data.positioning.taskCompletion_avg.NRG$BORG_NRG,
data.positioning.taskCompletion_avg.NRG$completion_time, method = "spearman")
## Warning in cor.test.default(data.positioning.taskCompletion_avg.NRG$BORG_NRG, :
## Cannot compute exact p-value with ties
##
## Spearman's rank correlation rho
##
## data: data.positioning.taskCompletion_avg.NRG$BORG_NRG and data.positioning.taskCompletion_avg.NRG$completion_time
## S = 4081328, p-value = 0.671
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## -0.02513373
# BORG vs Accuracy
ggplot(data.positioning.matched.RG, aes(x = BORG_RG, y = match_accuracy_result)) +
geom_point() +
geom_smooth(method = "lm", se = TRUE) +
labs(title = "Physical Exertion vs Match Accuracy", x = "BORG Scale (RG)", y = "Match Accuracy")
## `geom_smooth()` using formula = 'y ~ x'
ggplot(data.positioning.matched.NRG, aes(x = BORG_NRG, y = match_accuracy_result)) +
geom_point() +
geom_smooth(method = "lm", se = TRUE) +
labs(title = "Physical Exertion vs Match Accuracy", x = "BORG Scale (RG)", y = "Match Accuracy")
## `geom_smooth()` using formula = 'y ~ x'
data.positioning.matched.RG$condition <- "RG"
data.positioning.matched.NRG$condition <- "NRG"
data.positioning.matched.combined <- bind_rows(
data.positioning.matched.RG %>% rename(BORG = BORG_RG),
data.positioning.matched.NRG %>% rename(BORG = BORG_NRG)
)
ggplot(data.positioning.matched.combined, aes(x = BORG, y = match_accuracy_result, color = condition)) +
geom_point(alpha = 0.7) +
geom_smooth(method = "lm", se = TRUE) +
labs(
title = "Physical Exertion vs Match Accuracy",
x = "BORG Scale",
y = "Match Accuracy",
color = "Condition"
) +
scale_color_manual(values = c("RG" = "blue", "NRG" = "red")) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
# BORG vs Completion Time
data.positioning.taskCompletion_avg.RG$condition <- "RG"
data.positioning.taskCompletion_avg.NRG$condition <- "NRG"
data.positioning.taskCompletion_avg.combined <- bind_rows(
data.positioning.taskCompletion_avg.RG %>%
rename(BORG = BORG_RG),
data.positioning.taskCompletion_avg.NRG %>%
rename(BORG = BORG_NRG)
)
ggplot(data.positioning.taskCompletion_avg.combined, aes(x = BORG, y = completion_time, color = condition)) +
geom_point(alpha = 0.7) +
geom_smooth(method = "lm", se = TRUE) +
labs(
title = "Physical Exertion vs Completion Time",
x = "BORG Scale",
y = "Completion Time (min)",
color = "Condition"
) +
scale_color_manual(values = c("RG" = "blue", "NRG" = "red")) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
#### Preference
data.scale %>%
select(UserID, behaviour_preference) %>%
distinct() %>%
count(behaviour_preference) %>%
mutate(
percent = n / sum(n),
ncount = paste0(n, "\n", percent_format()(percent))
) %>%
ggplot(aes(x = "", y = n, fill = behaviour_preference)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
geom_text(aes(label = ncount), position = position_stack(vjust = 0.5), size = 4) +
labs(
title = "Distribution of Scale Behaviour Preferences",
fill = "Preference"
) +
theme_void()
#### Comments
### Summary